MODULE menu
  !-----------------------------------------------------------
  ! KRUUNUNHAKA basis set tool kit - menu routines
  !-----------------------------------------------------------
  ! See CHANGELOG
  !-----------------------------------------------------------
  ! Copyright (C) 2003-2008 Pekka Manninen, 2010 Jussi Lehtola
  !
  ! This program is distributed under the terms of the GNU General
  ! Public License as published by the Free Software Foundation;
  ! either version 2 of the License, or (at your option) any later version.
  !
  ! This program is distributed in the hope that it will be useful,
  ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
  !
  ! Please note that this program as well as its 
  ! author must be properly cited whenever the program or some parts 
  ! originated on it are employed. 
  !
  !-----------------------------------------------------------

  USE definitions
  USE textutil
  IMPLICIT NONE
CONTAINS

  ! Print out values
  SUBROUTINE print_vals(vals,c)
    IMPLICIT NONE
    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: vals
    CHARACTER, INTENT(IN) :: c

    CHARACTER(LEN=TERMWIDTH) :: strhelp
    CHARACTER(LEN=TERMWIDTH) :: trlab
    INTEGER :: i, j
    INTEGER :: strlen

    ! Print out choices
    DO i=1,SIZE(vals)
       ! Zero out helper string
       DO j=1,TERMWIDTH
          strhelp(j:j)=' '
       END DO

       ! Set left border
       strhelp(1:1)=c

       ! Trim label
       trlab=TRIM(vals(i))
       ! Calculate length of label
       strlen=LEN(TRIM(trlab))

       ! Set label
       strhelp(3:3+strlen)=trlab(1:strlen)

       ! Set right border
       strhelp(TERMWIDTH:TERMWIDTH)=c

       ! Print choice
       WRITE (*,'(A)') strhelp
    END DO
  END SUBROUTINE print_vals

  ! Print out choices.
  SUBROUTINE print_choice(labels,vals,c)
    IMPLICIT NONE
    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: labels
    CHARACTER(LEN=*), INTENT(IN) :: vals
    CHARACTER, INTENT(IN) :: c
    
    INTEGER :: i, j
    INTEGER :: strlen
    CHARACTER(LEN=TERMWIDTH) :: strhelp
    CHARACTER(LEN=TERMWIDTH) :: trlab

    IF(size(labels) /= LEN(vals)) THEN
       WRITE (*,*) 'Error in menu.f90 - amount of labels and choices does not match!'
       STOP
    END IF
    
    ! Print out choices
    DO i=1,LEN(vals)
       ! Zero out helper string
       DO j=1,TERMWIDTH
          strhelp(j:j)=' '
       END DO

       ! Set left border
       strhelp(1:1)=c
       ! Set choice number
       strhelp(3:3)=vals(i:i)
       strhelp(4:4)='.'

       ! Trim label
       trlab=TRIM(labels(i))
       ! Calculate length of label
       strlen=LEN(TRIM(trlab))

       ! Set label
       strhelp(6:6+strlen)=trlab(1:strlen)

       ! Set right border
       strhelp(TERMWIDTH:TERMWIDTH)=c

       ! Print choice
       WRITE (*,'(A)') strhelp
    END DO
  END SUBROUTINE print_choice

  ! Get answer y/n
  FUNCTION make_yn(question) RESULT(ok)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: question

    LOGICAL :: ok, inputok
    CHARACTER :: c

    INTEGER :: stat

    ok=.FALSE.

    stat=1
    inputok=.FALSE.
    DO WHILE(.NOT. inputok .OR. stat /= 0)
       WRITE (*,'(A,A,A)',advance='no') TRIM(question),' Proceed? (y/n) ',' '
       READ (*,'(A)',iostat=stat) c

       IF(str_up_to_lo(c)=='n') THEN
          ok=.FALSE.
          inputok=.TRUE.
       ELSEIF(str_up_to_lo(c)=='y') THEN
          ok=.TRUE.
          inputok=.TRUE.
       END IF
    END DO
  END FUNCTION make_yn
       
  ! Get the selection from a menu
  FUNCTION make_selection(menutit,labels,vals,c) RESULT(found)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: menutit
    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: labels
    CHARACTER(LEN=*), INTENT(IN) :: vals
    CHARACTER, INTENT(IN) :: c

    CHARACTER :: sel
    INTEGER :: i
    INTEGER :: found

    INTEGER :: stat

    IF(size(labels) /= LEN(vals)) THEN
       WRITE (*,*) 'Error in menu.f90 - amount of labels and choices does not match!'
       STOP
    END IF

    ! Loop until a valid input is given
    found=0
    stat=1
    DO WHILE(found==0 .OR. stat /=0)

       ! Print a vertical bar
       CALL print_vertbar(c)
       CALL print_center(menutit,c)
       CALL print_vertbar(c)
       ! Print out menu
       CALL print_choice(labels,vals,c)
       CALL print_vertbar(c)
       
       ! Print choice
       WRITE (*,'(A)', ADVANCE='no') '> '

       ! Read selection
       READ (*,'(A)',iostat=stat) sel

       ! Check if selection is in allowed values
       DO i=1,LEN(vals)
          ! Found it!
          IF(vals(i:i)==sel) THEN
             found=i
             EXIT
          END IF
       END DO

       IF(found==0) THEN
          WRITE (*,'(A,A,A/)') 'Invalid selection. Valid choices are [', vals,'].'
       ELSE
          WRITE (*,*) ''
       END IF
    END DO
  END FUNCTION make_selection

  ! Print out current values and get the selection from a menu
  FUNCTION make_cvals_selection(menutit,currentvals,labels,vals,c) RESULT(found)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: menutit
    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: currentvals
    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: labels
    CHARACTER(LEN=*), INTENT(IN) :: vals
    CHARACTER, INTENT(IN) :: c

    CHARACTER :: sel
    INTEGER :: i
    INTEGER :: found

    INTEGER :: stat

    IF(size(labels) /= LEN(vals)) THEN
       WRITE (*,*) 'Error in menu.f90 - amount of labels and choices does not match!'
       STOP
    END IF

    ! Loop until a valid input is given
    found=0
    stat=1
    DO WHILE(found==0 .OR. stat /= 0)

       ! Print a vertical bar
       CALL print_vertbar(c)
       CALL print_center(menutit,c)
       CALL print_vertbar(c)
       ! Print out current values
       CALL print_vals(currentvals,c)
       CALL print_vertbar(c)
       ! Print out menu
       CALL print_choice(labels,vals,c)
       CALL print_vertbar(c)
       
       ! Print choice
       WRITE (*,'(A)', ADVANCE='no') '> '

       ! Read selection
       READ (*,'(A)',iostat=stat) sel

       ! Check if selection is in allowed values
       DO i=1,LEN(vals)
          ! Found it!
          IF(vals(i:i)==sel) THEN
             found=i
             EXIT
          END IF
       END DO

       IF(found==0) THEN
          WRITE (*,'(A,A,A/)') 'Invalid selection. Valid choices are [', vals,'].'
       ELSE
          WRITE (*,*) ''
       END IF
    END DO
  END FUNCTION make_cvals_selection
      
END MODULE MENU
